home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / auto-l1a / idbas_re.bas < prev    next >
BASIC Source File  |  1999-03-30  |  6KB  |  113 lines
  1. Attribute VB_Name = "IDBAS_Registry"
  2. Option Explicit
  3. 'Special Area
  4. Public Const REG_SZ As Long = 1
  5. Public Const REG_DWORD As Long = 4
  6.  
  7. Public Enum hKeyNames
  8.     HKEY_CLASSES_ROOT = &H80000000
  9.     HKEY_CURRENT_USER = &H80000001
  10.     HKEY_LOCAL_MACHINE = &H80000002
  11.     HKEY_USERS = &H80000003
  12. End Enum
  13.  
  14. Public Const ERROR_NONE = 0
  15. Public Const ERROR_BADDB = 1
  16. Public Const ERROR_BADKEY = 2
  17. Public Const ERROR_CANTOPEN = 3
  18. Public Const ERROR_CANTREAD = 4
  19. Public Const ERROR_CANTWRITE = 5
  20. Public Const ERROR_OUTOFMEMORY = 6
  21. Public Const ERROR_ARENA_TRASHED = 7
  22. Public Const ERROR_ACCESS_DENIED = 8
  23. Public Const ERROR_INVALID_PARAMETERS = 87
  24. Public Const ERROR_NO_MORE_ITEMS = 259
  25.  
  26. Public Const KEY_ALL_ACCESS = &H3F
  27.  
  28. Public Const REG_OPTION_NON_VOLATILE = 0
  29.  
  30. Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
  31. Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias "RegCreateKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal Reserved As Long, ByVal lpClass As String, ByVal dwOptions As Long, ByVal samDesired As Long, ByVal lpSecurityAttributes As Long, phkResult As Long, lpdwDisposition As Long) As Long
  32. Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
  33. Declare Function RegQueryValueExString Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As String, lpcbData As Long) As Long
  34. Declare Function RegQueryValueExLong Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Long, lpcbData As Long) As Long
  35. Declare Function RegQueryValueExNULL Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As Long, lpcbData As Long) As Long
  36. Declare Function RegSetValueExString Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal lpValue As String, ByVal cbData As Long) As Long
  37. Declare Function RegSetValueExLong Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpValue As Long, ByVal cbData As Long) As Long
  38.  
  39.  
  40.    Private Function SetValueEx(ByVal hKey As Long, sValueName As String, lType As Long, vValue As Variant) As Long
  41.        Dim lValue As Long
  42.        Dim sValue As String
  43.        Select Case lType
  44.            Case REG_SZ
  45.                sValue = vValue & Chr$(0)
  46.                SetValueEx = RegSetValueExString(hKey, sValueName, 0&, lType, sValue, Len(sValue))
  47.            Case REG_DWORD
  48.                lValue = vValue
  49.                SetValueEx = RegSetValueExLong(hKey, sValueName, 0&, lType, lValue, 4)
  50.            End Select
  51.    End Function
  52.  
  53.    Private Function QueryValueEx(ByVal lhKey As Long, ByVal szValueName As String, vValue As Variant) As Long
  54.        Dim cch As Long
  55.        Dim lrc As Long
  56.        Dim lType As Long
  57.        Dim lValue As Long
  58.        Dim sValue As String
  59.  
  60.        On Error GoTo QueryValueExError
  61.  
  62.        ' Determine the size and type of data to be read
  63.        lrc = RegQueryValueExNULL(lhKey, szValueName, 0&, lType, 0&, cch)
  64.        If lrc <> ERROR_NONE Then Error 5
  65.  
  66.        Select Case lType
  67.            ' For strings
  68.            Case REG_SZ:
  69.                sValue = String(cch, 0)
  70.    lrc = RegQueryValueExString(lhKey, szValueName, 0&, lType, sValue, cch)
  71.                If lrc = ERROR_NONE Then
  72.                    vValue = Left$(sValue, cch - 1)
  73.                Else
  74.                    vValue = Empty
  75.                End If
  76.            ' For DWORDS
  77.            Case REG_DWORD:
  78.    lrc = RegQueryValueExLong(lhKey, szValueName, 0&, lType, lValue, cch)
  79.                If lrc = ERROR_NONE Then vValue = lValue
  80.            Case Else
  81.                'all other data types not supported
  82.                lrc = -1
  83.        End Select
  84.  
  85. QueryValueExExit:
  86.        QueryValueEx = lrc
  87.        Exit Function
  88. QueryValueExError:
  89.        Resume QueryValueExExit
  90.    End Function
  91.  
  92.    Public Function GetSettingSpecial(AppName As String, Section As String, Key As String, Optional Default As String, Optional hKeyName As hKeyNames = HKEY_LOCAL_MACHINE, Optional AppNameHeader = "SOFTWARE\Makino")
  93.         Dim lRetVal As Long      'result of the API functions
  94.         Dim hKey As Long         'handle of opened key
  95.         Dim vValue As Variant    'setting of queried value
  96.  
  97.         lRetVal = RegOpenKeyEx(hKeyName, AppNameHeader & "\" & AppName & "\" & Section, 0, KEY_ALL_ACCESS, hKey)
  98.         lRetVal = QueryValueEx(hKey, Key, vValue)
  99.         If IsEmpty(vValue) Then vValue = Default
  100.         GetSettingSpecial = vValue
  101.         RegCloseKey (hKey)
  102.    End Function
  103.    Public Sub SaveSettingSpecial(AppName As String, Section As String, Key As String, Setting As String, Optional hKeyName As hKeyNames = HKEY_LOCAL_MACHINE, Optional AppNameHeader = "SOFTWARE\Makino")
  104.        Dim lRetVal As Long       'result of the SetValueEx function
  105.        Dim hKey As Long          'handle of open key
  106.  
  107.        'open the specified key
  108.        lRetVal = RegCreateKeyEx(hKeyName, AppNameHeader & "\" & AppName & "\" & Section, 0&, vbNullString, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, 0&, hKey, lRetVal)
  109.        lRetVal = SetValueEx(hKey, Key, REG_SZ, Setting)
  110.        RegCloseKey (hKey)
  111.    End Sub
  112.  
  113.